home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / VIDEO / FERNANDO.PAS next >
Pascal/Delphi Source File  |  1993-02-26  |  4KB  |  142 lines
  1. {****************************************************************************}
  2. {***********************                              ***********************}
  3. {**                           R-G-B Demonstrator                           **}
  4. {****************************                    ****************************}
  5. {**                       Copyrighted February 12, 1993                    **}
  6. {**                       (C) To Authors                                   **}
  7. {**                             Fernando Padilla                           **}
  8. {******************************                ******************************}
  9. {****************************************************************************}
  10. unit Fernando;
  11.  
  12. interface
  13.  
  14. uses
  15.    Roger;
  16. const
  17.    blendframes:byte=100;
  18.  
  19.    gfull=63;
  20.    ggone=15;
  21.    gnone=0;
  22.  
  23.    rfull=100;
  24.    rgone=24;
  25.    rnone=0;
  26.  
  27. type
  28.    pRGB=(
  29.          R,
  30.       RRRG,
  31.        RRG,
  32.      RRRGG,
  33.         RG,
  34.      RRGGG,
  35.        RGG,
  36.       RGGG,
  37.          G,
  38.       GGGB,
  39.        GGB,
  40.      GGGBB,
  41.         GB,
  42.      GGBBB,
  43.        GBB,
  44.       GBBB,
  45.          B,
  46.       BBBR,
  47.        BBR,
  48.      BBBRR,
  49.         BR,
  50.      BBRRR,
  51.        BRR,
  52.       BRRR,
  53.          W
  54.           );
  55.    cRGB=record
  56.         color,
  57.         red,
  58.         green,
  59.         blue:byte;
  60.    end;
  61.  
  62.  
  63.  function rat(percent:byte):integer;
  64.  function ginverse(a:integer):integer;
  65.  function rinverse(a:integer):integer;
  66. procedure setcolr(a,b,c,d:integer);
  67. procedure setrevcolr(a,b,c,d:integer);
  68. procedure park(a,b,c,d:integer;  var p:crgb);
  69. procedure getcolr(c:prgb;  var p:crgb;  i:integer);
  70.  function increment(n1,n2,p:integer):integer;
  71. procedure incrementer(p1,p2:crgb; a:byte; var p3:crgb);
  72.  
  73.  
  74. implementation
  75.  
  76. function rat(percent:byte):integer;
  77.    begin  rat:=trunc(gfull*(percent/rfull)); end;
  78. function ginverse(a:integer):integer;
  79.    begin  ginverse:=abs(a-gfull);  end;
  80. function rinverse(a:integer):integer;
  81.    begin  rinverse:=abs(a-rfull);  end;
  82. procedure setcolr(a,b,c,d:integer);
  83.    begin   putcolor(a,rat(b),rat(c),rat(d));  end;
  84. procedure setrevcolr(a,b,c,d:integer);
  85.    begin   PutColor(a,rat(rinverse(b)),rat(rinverse(c)),rat(rinverse(d)));  end;
  86. procedure park(a,b,c,d:integer;  var p:crgb);
  87.   begin
  88.      with p do begin
  89.         color:=a;
  90.         red:=b;
  91.         green:=c;
  92.         blue:=d;
  93.      end;
  94.   end;
  95. procedure getcolr(c:prgb;  var p:crgb;  i:integer);
  96.   begin
  97.      Case c of
  98.        R: park(0,i,0,0,p);
  99.     RRRG: park(0,i,i div 3,0,p);
  100.      RRG: park(0,i,i div 2,0,p);
  101.    RRRGG: park(0,i,(i*2) div 3,0,p);
  102.       RG: park(0,i,i,0,p);
  103.    RRGGG: park(0,(i*2) div 3,i,0,p);
  104.      RGG: park(0,i div 2,i,0,p);
  105.     RGGG: park(0,i div 3,i,0,p);
  106.        G: park(0,0,i,0,p);
  107.     GGGB: park(0,0,i,i div 3,p);
  108.      GGB: park(0,0,i,i div 2,p);
  109.    GGGBB: park(0,0,i,(i*2) div 3,p);
  110.       GB: park(0,0,i,i,p);
  111.    GGBBB: park(0,0,(i*2) div 3,i,p);
  112.      GBB: park(0,0,i div 2,i,p);
  113.     GBBB: park(0,0,i div 3,i,p);
  114.        B: park(0,0,0,i,p);
  115.     BBBR: park(0,i div 3,0,i,p);
  116.      BBR: park(0,i div 2,0,i,p);
  117.    BBBRR: park(0,(i*2) div 3,0,i,p);
  118.       BR: park(0,i,0,i,p);
  119.    BBRRR: park(0,i,0,(i*2) div 3,p);
  120.      BRR: park(0,i,0,i div 2,p);
  121.     BRRR: park(0,i,0,i div 3,p);
  122.        W: park(0,i,i,i,p);
  123.  
  124.      end;
  125.   end;
  126. function increment(n1,n2,p:integer):integer;
  127.    begin  increment:=trunc(((n2-n1)*(p/blendframes))+n1);  end;
  128. procedure incrementer(p1,p2:crgb; a:byte; var p3:crgb);
  129.   begin
  130.      if p1.color=p2.color then
  131.         with p3 do begin
  132.            color:=p1.color;
  133.            red:=increment(p1.red,p2.red,a);
  134.            green:=increment(p1.green,p2.green,a);
  135.            blue:=increment(p1.blue,p2.blue,a);
  136.         end;
  137.   end;
  138.  
  139.  
  140.  
  141. begin
  142. end.